home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / Recopier.AmiCAD < prev    next >
Text File  |  2000-04-13  |  3KB  |  162 lines

  1. /* Clonage d'un composant, en "augmentant sa référence"
  2.    Version 1.00: 22 décembre 1998
  3.    Version 1.01: 25 Février 1999 (modif appel ASKNUM)
  4.    Version 1.02: 13 Avril 2000 (adaptation version 2.05)
  5. $VER: 1.02 (© R.Florac, 13 avril 2000) */
  6.  
  7. options results     /* indispensable pour récupérer le résultat des macros */
  8.  
  9. signal on error     /* pour l'interception des erreurs */
  10. signal on syntax
  11.  
  12. 'FIRSTSEL'
  13. o=result
  14. if o=0 then do
  15.     'MESSAGE("Sélectionnez le"+CHR(10)+"composant à recopier!")'
  16.     exit
  17. end
  18.  
  19. type=0
  20. do while type=0
  21.     'TYPE('o')'
  22.     select
  23.     when result=1 then do
  24.         type=1
  25.         leave
  26.     end
  27.     when result=4 then do
  28.         type=4
  29.         leave
  30.     end
  31.     when result=11 then do
  32.         type=11
  33.         leave
  34.     end
  35.     when result=12 then do
  36.         type=12
  37.         leave
  38.     end
  39.     otherwise nop
  40.     end
  41.     'NEXTSEL('o')'; o=result
  42.     if o=0 then do
  43.     'MESSAGE("Sélection incorrecte")'
  44.     exit
  45.     end
  46. end
  47.  
  48. if type=1 then 'READTEXT(GETREF('o'))'
  49. else 'READTEXT('o')'
  50. ref=result
  51. j=numero_reference(ref)
  52. ref=reference(ref)
  53. 'WIDTH(0)'; l=(result%10)*10
  54. 'HEIGHT(0)'; h=(result%10)*10
  55. 'COL(0)'; x0=result
  56. 'LINE(0)'; y0=result
  57. 'SELECT("Sens de la copie"+CHR(10)+"Vers le bas"+CHR(10)+"Vers la droite"+CHR(10)+"Vers le haut"+CHR(10)+"Vers la gauche")'
  58. sens=result
  59. if sens < 1 then exit
  60. 'ASKNUM("Combien de fois"+CHR(10)+"voulez-vous effectuer"+CHR(10)+"l''opération?",2)'
  61. n=result
  62. if n<1 then exit
  63. 'SELECT("Pas entre les copies"+CHR(10)+"10 pixels"+CHR(10)+"20 pixels"+CHR(10)+"30 pixels"+CHR(10)+"Automatique"+CHR(10)+"Spécifié")'
  64. pas = result
  65. select
  66.     when pas=1 then pas=0
  67.     when pas=2 then pas=10
  68.     when pas=3 then pas=20
  69.     when pas=4 then do
  70.     if sens=1 | sens=3 then pas=h
  71.     else pas=l
  72.     end
  73.     when pas=5 then do
  74.     'ASKNUM("Pas entre les copies",10)'
  75.     pas=result
  76.     end
  77.     otherwise exit
  78. end
  79.  
  80. 'COPY(5):SAVEALL'           /* sauvegarde des éléments à copier */
  81. do i=1 to n
  82.     select
  83.     when sens=1 then do    /* Copie vers le bas */
  84.         yy=y0+(10+pas)*i
  85.         yy=(yy%10)*10
  86.         'PASTE(5,'x0','yy')'
  87.     end
  88.     when sens=2 then do
  89.         xx=x0+(10+pas)*i
  90.         xx=(xx%10)*10
  91.         'PASTE(5,'xx','y0')'
  92.     end
  93.     when sens=3 then do
  94.         yy=y0-(10+pas)*i
  95.         yy=(yy%10)*10
  96.         'PASTE(5,'x0','yy')'
  97.     end
  98.     otherwise do
  99.         'MESSAGE("Pas encore implémenté!")'
  100.     end
  101.     end
  102.     if ref ~= "" then do
  103.     j=j+1
  104.     k=indice(type)
  105.     if type=1 then 'SETREF('k',"'ref||j'"):UNMARK(-1)'
  106.     else 'SETTEXT('k',"'ref||j'"):UNMARK(-1)'
  107.     end
  108. end
  109.  
  110. exit
  111.  
  112. indice: procedure
  113.     parse arg type
  114.     'FIRSTSEL'
  115.     o=result
  116.     do while o>0
  117.     'TYPE('o')'
  118.     select
  119.         when result=type then return o
  120.         otherwise nop
  121.     end
  122.     'NEXTSEL('o')'; o=result
  123.     end
  124.     return 0
  125.  
  126. reference: procedure
  127.     parse arg ref
  128.     i=length(ref)
  129.     do while i>1
  130.     c=substr(ref,i,1)
  131.     if datatype(c)=NUM then ref=left(ref,i-1)
  132.     else return ref
  133.     i=i-1
  134.     end
  135.     return ref
  136.  
  137. numero_reference: procedure
  138.     parse arg ref
  139.     i=length(ref)
  140.     r=0
  141.     rang=1
  142.     do while i>1
  143.     c=substr(ref,i,1)
  144.     if datatype(c)=NUM then do
  145.         r=r+c*rang
  146.         rang=rang*10
  147.     end
  148.     else return r
  149.     i=i-1
  150.     end
  151.     return r
  152.  
  153. /* Traitement des erreurs, interruption du programme */
  154. syntax:
  155. erreur=RC
  156. 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  157. exit
  158.  
  159. error:
  160. 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  161. exit
  162.